home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PsL Monthly 1993 December
/
PSL Monthly Shareware CD-ROM (December 1993).iso
/
prgmming
/
dos
/
pascal
/
combox.exe
/
COMBO.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-12-24
|
8KB
|
313 lines
Unit Combo;
interface
uses Views, Objects, Drivers, Dialogs, StdDlg, Dos;
{
Author: Keith Greer
68 Tamworth Rd.
Troy, OH 45373-1551
C'Serve ID: 73457,3042
Internet: greerk@wpdis11.hq.aflc.af.mil
This unit defines a "combo box" pull down selection list ala Windows.
The combo box looks and works similar to the history list. The
difference is, the history window only contains a limited number of
strings you have previously typed in the linked input line, whereas
the combo box displays a sorted collection and supports "power
typing" like TFileDialog.
}
const
cmOkNext = 2200;
type
{TComboCollection}
PComboCollection = ^TComboCollection;
TComboCollection = object(TSortedCollection)
function TxtPtr(Item : integer) : String; virtual;
end;
{TComboListBox}
PComboListBox = ^TComboListBox;
TComboListBox = object(TSortedListBox)
constructor Init(var Bounds : TRect; ANumCols : word;
AScrollBar : PScrollBar);
procedure HandleEvent(var Event : TEvent); virtual;
procedure FocusItem(Item: Integer); virtual;
function GetText(Item: Integer; MaxLen: Integer): String; virtual;
function GetPalette : PPalette; virtual;
end;
{TComboWindow}
PComboWindow = ^TComboWindow;
TComboWindow = object(TWindow)
SelText : string;
constructor Init(var Bounds : TRect; ListPtr : PComboCollection);
constructor Load(var S : TStream);
procedure Store(var S : TStream);
procedure HandleEvent(var Event : TEvent); virtual;
function GetPalette : PPalette; virtual;
end;
{TComboBox}
PComboBox = ^TComboBox;
TComboBox = object(TView)
ILine : PInputLine;
List : PComboCollection;
ILineFocused : Boolean;
constructor Init(var Bounds : TRect; LinePtr : PInputLine;
ListPtr : PComboCollection);
constructor Load(var S : TStream);
procedure Store(var S : TStream);
procedure Draw; virtual;
procedure HandleEvent(var Event : TEvent); virtual;
function GetPalette: PPalette; virtual;
end;
procedure RegisterCombo;
const
RComboCollection : TStreamRec = (
ObjType : 1000;
VmtLink : Ofs(TypeOf(TComboCollection)^);
Load : @TComboCollection.Load;
Store : @TComboCollection.Store
);
RComboListBox : TStreamRec = (
ObjType : 1001;
VmtLink : Ofs(TypeOf(TComboListBox)^);
Load : @TComboListBox.Load;
Store : @TComboListBox.Store
);
RComboWindow : TStreamRec = (
ObjType : 1002;
VmtLink : Ofs(TypeOf(TComboWindow)^);
Load : @TComboWindow.Load;
Store : @TComboWindow.Store
);
RComboBox : TStreamRec = (
ObjType : 1003;
VmtLink : Ofs(TypeOf(TComboBox)^);
Load : @TComboBox.Load;
Store : @TComboBox.Store
);
implementation
{TComboCollection}
function TComboCollection.TxtPtr;
begin
TxtPtr := String(At(Item)^);
end;
{TComboListBox}
constructor TComboListBox.Init(var Bounds : TRect; ANumCols : word;
AScrollBar : PScrollBar);
begin
TSortedListBox.Init(Bounds, ANumCols, AScrollBar);
end;
procedure TComboListBox.FocusItem(Item: Integer);
begin
TSortedListbox.FocusItem(Item);
if Owner <> nil then
PComboWindow(Owner)^.SelText := PComboCollection(List)^.TxtPtr(Item);
end;
function TComboListBox.GetText;
var
S : string;
begin
if List <> nil then
S := PComboCollection(List)^.TxtPtr(Item);
if Length(S) > MaxLen then S[0] := Char(MaxLen);
GetText := S;
end;
procedure TComboListBox.HandleEvent;
begin
if List=nil then exit;
if ((Event.What = evMouseDown) and (Event.Double)) or
((Event.What = evKeyDown) and (Event.KeyCode = kbEnter)) then
begin
Event.What := evCommand;
Event.Command := cmOK;
PutEvent(Event);
ClearEvent(Event);
end
else if ((Event.What = evKeyDown) and (Event.KeyCode = kbTab)) then
begin
Event.What := evCommand;
Event.Command := cmOkNext;
PutEvent(Event);
ClearEvent(Event);
end
else TSortedListBox.HandleEvent(Event);
end;
function TComboListBox.GetPalette : PPalette;
const
P : string[Length(CHistoryViewer)] = CHistoryViewer;
begin
GetPalette := @P;
end;
{TComboWindow}
constructor TComboWindow.Init;
var
sbPtr : PScrollBar;
R : TRect;
B : PComboListBox;
begin
TWindow.Init(Bounds, '', wnNoNumber);
GetExtent(R); R.Grow(-1,-1);
Flags := Flags and not (wfGrow + wfMove + wfZoom);
if ListPtr<>nil then
begin
sbPtr := StandardScrollBar(sbVertical);
B := New(PComboListBox, Init(R,1, sbPtr));
B^.NewList(ListPtr);
Insert(B);
B^.FocusItem(0);
end;
end;
constructor TComboWindow.Load(var S : TStream);
begin
TWindow.Load(S);
S.Read(SelText, SizeOf(string));
end;
procedure TComboWindow.Store(var S : TStream);
begin
TWindow.Store(S);
S.Write(SelText, SizeOf(string));
end;
function TComboWindow.GetPalette : PPalette;
const
P : string[Length(CHistoryWindow)] = CHistoryWindow;
begin
GetPalette := @P;
end;
procedure TComboWindow.HandleEvent;
begin
if ((Event.What = evKeyDown) and (Event.KeyCode = kbEsc)) or
((Event.What = evMouseDown) and (Event.Buttons = mbRightButton)) then
begin
Event.What := evCommand;
Event.Command := cmCancel;
end;
if (Event.What = evCommand) then
case Event.Command of
cmOK, cmCancel,cmOkNext : EndModal(Event.Command);
end;
TWindow.HandleEvent(Event);
end;
{TComboBox}
constructor TComboBox.Init;
begin
if (LinePtr=nil) or (ListPtr=nil) then Fail;
TView.Init(Bounds);
Options := Options or ofPostProcess;
EventMask := EventMask or evBroadcast;
ILine := LinePtr;
List := ListPtr;
end;
constructor TComboBox.Load(var S : TStream);
begin
TView.Load(S);
GetPeerViewPtr(S, ILine);
List := PComboCollection(S.Get);
S.Read(ILineFocused, SizeOf(boolean));
end;
procedure TComboBox.Store(var S : TStream);
begin
TView.Store(S);
PutPeerViewPtr(S, ILine);
S.Put(List);
S.Write(ILineFocused, SizeOf(boolean));
end;
procedure TComboBox.HandleEvent;
var
R,Extent : TRect;
W : PComboWindow;
Control : integer;
begin
if (Event.What = evBroadcast) and (PInputLine(Event.InfoPtr) = ILine) then
begin
case Event.Command of
cmReceivedFocus : ILineFocused := True;
cmReleasedFocus : ILineFocused := False;
end;
ClearEvent(Event);
end;
if (Event.What = evMouseDown) or ((Event.What = evKeyDown) and
(Event.KeyCode = kbDown) and ILineFocused) and (List^.Count>0) then
begin
if not ILineFocused then ILine^.Select;
Owner^.GetExtent(Extent);
ILine^.GetBounds(R); R.Grow(1,1); R.B.Y := Extent.B.Y - 1;
if List^.Count < (R.B.Y - R.A.Y - 1) then
R.B.Y := R.A.Y + List^.Count + 2;
W := New(PComboWindow, Init(R, List));
Control := Owner^.ExecView(W);
if Control <> cmCancel then
begin
ILine^.Data^ := W^.SelText;
ILine^.SelectAll(False);
ILine^.DrawView;
end;
Dispose(W,Done);
if Control = cmOkNext then Owner^.SelectNext(False);
ClearEvent(Event);
end
else TView.HandleEvent(Event);
end;
function TComboBox.GetPalette : PPalette;
const
P : string[Length(CHistory)] = CHistory;
begin
GetPalette := @P;
end;
procedure TComboBox.Draw;
begin
WriteChar(0,0,#222,2,1);
WriteChar(1,0,#25,1,1);
WriteChar(2,0,#221,2,1);
end;
procedure RegisterCombo;
begin
RegisterType(RComboCollection);
RegisterType(RComboListBox);
RegisterType(RComboWindow);
RegisterType(RComboBox);
end;
end. {Combo}